home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / gnu / emacs / emacs1857 / bin_d2.zoo / lisp / dired.el < prev    next >
Lisp/Scheme  |  1991-12-02  |  22KB  |  630 lines
  1. ;;; Missing: P command, sorting, setting file modes.
  2. ;;; Dired buffer containing multiple directories gets totally confused
  3. ;;; Implement insertion of subdirectories in situ --- tree dired
  4.  
  5. ;; DIRED commands for Emacs
  6. ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 1, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24.  
  25. ;In loaddefs.el
  26. ;(defvar dired-listing-switches "-al"
  27. ;  "Switches passed to ls for dired. MUST contain the 'l' option.
  28. ;CANNOT contain the 'F' option.")
  29.  
  30. (defun dired-readin (dirname buffer)
  31.   (save-excursion
  32.     (message "Reading directory %s..." dirname)
  33.     (set-buffer buffer)
  34.     (let ((buffer-read-only nil))
  35.       (widen)
  36.       (erase-buffer)
  37.       (setq dirname (expand-file-name dirname))
  38.       (if (file-directory-p dirname)
  39.       (call-process "/bin/bin/ls.ttp" nil buffer nil
  40.             dired-listing-switches dirname)
  41.     (let ((default-directory (file-name-directory dirname)))
  42.       (call-process shell-file-name nil buffer nil
  43.             "-c" (concat "/bin/bin/ls.ttp " dired-listing-switches " "
  44.                      (file-name-nondirectory dirname)))))
  45.       (goto-char (point-min))
  46.       (while (not (eobp))
  47.     (insert "  ")
  48.     (forward-line 1))
  49.       (goto-char (point-min)))
  50.     (message "Reading directory %s...done" dirname)))
  51.  
  52. (defun dired-find-buffer (dirname)
  53.   (let ((blist (buffer-list))
  54.     found)
  55.     (while blist
  56.       (save-excursion
  57.         (set-buffer (car blist))
  58.     (if (and (eq major-mode 'dired-mode)
  59.          (equal dired-directory dirname))
  60.         (setq found (car blist)
  61.           blist nil)
  62.       (setq blist (cdr blist)))))
  63.     (or found
  64.     (create-file-buffer (directory-file-name dirname)))))
  65.  
  66. (defun dired (dirname)
  67.   "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
  68. Dired displays a list of files in DIRNAME.
  69. You can move around in it with the usual commands.
  70. You can flag files for deletion with C-d
  71. and then delete them by typing `x'.
  72. Type `h' after entering dired for more info."
  73.   (interactive (list (read-file-name "Dired (directory): "
  74.                      nil default-directory nil)))
  75.   (switch-to-buffer (dired-noselect dirname)))
  76.  
  77. (defun dired-other-window (dirname)
  78.   "\"Edit\" directory DIRNAME.  Like M-x dired but selects in another window."
  79.   (interactive (list (read-file-name "Dired in other window (directory): "
  80.                      nil default-directory nil)))
  81.   (switch-to-buffer-other-window (dired-noselect dirname)))
  82.  
  83. (defun dired-noselect (dirname)
  84.   "Like M-x dired but returns the dired buffer as value, does not select it."
  85.   (or dirname (setq dirname default-directory))
  86.   (setq dirname (expand-file-name (directory-file-name dirname)))
  87.   (if (file-directory-p dirname)
  88.       (setq dirname (file-name-as-directory dirname)))
  89.   (let ((buffer (dired-find-buffer dirname)))
  90.     (save-excursion
  91.       (set-buffer buffer)
  92.       (dired-readin dirname buffer)
  93.       (dired-move-to-filename)
  94.       (dired-mode dirname))
  95.     buffer))
  96.  
  97. (defun dired-revert (&optional arg noconfirm)
  98.   (let ((opoint (point))
  99.     (ofile (dired-get-filename t t))
  100.     (buffer-read-only nil))
  101.     (erase-buffer)
  102.     (dired-readin dired-directory (current-buffer))
  103.     (or (and ofile (re-search-forward (concat " " (regexp-quote ofile) "$")
  104.                       nil t))
  105.     (goto-char opoint))
  106.     (beginning-of-line)))
  107.  
  108. (defvar dired-mode-map nil "Local keymap for dired-mode buffers.")
  109. (if dired-mode-map
  110.     nil
  111.   (setq dired-mode-map (make-keymap))
  112.   (suppress-keymap dired-mode-map)
  113.   (define-key dired-mode-map "r" 'dired-rename-file)
  114.   (define-key dired-mode-map "\C-d" 'dired-flag-file-deleted)
  115.   (define-key dired-mode-map "d" 'dired-flag-file-deleted)
  116.   (define-key dired-mode-map "v" 'dired-view-file)
  117.   (define-key dired-mode-map "e" 'dired-find-file)
  118.   (define-key dired-mode-map "f" 'dired-find-file)
  119.   (define-key dired-mode-map "o" 'dired-find-file-other-window)
  120.   (define-key dired-mode-map "u" 'dired-unflag)
  121.   (define-key dired-mode-map "x" 'dired-do-deletions)
  122.   (define-key dired-mode-map "\177" 'dired-backup-unflag)
  123.   (define-key dired-mode-map "?" 'dired-summary)
  124.   (define-key dired-mode-map "c" 'dired-copy-file)
  125.   (define-key dired-mode-map "#" 'dired-flag-auto-save-files)
  126.   (define-key dired-mode-map "~" 'dired-flag-backup-files)
  127.   (define-key dired-mode-map "." 'dired-clean-directory)
  128.   (define-key dired-mode-map "h" 'describe-mode)
  129.   (define-key dired-mode-map " "  'dired-next-line)
  130.   (define-key dired-mode-map "\C-n" 'dired-next-line)
  131.   (define-key dired-mode-map "\C-p" 'dired-previous-line)
  132.   (define-key dired-mode-map "n" 'dired-next-line)
  133.   (define-key dired-mode-map "p" 'dired-previous-line)
  134.   (define-key dired-mode-map "g" 'revert-buffer)
  135.   (define-key dired-mode-map "C" 'dired-compress)
  136.   (define-key dired-mode-map "U" 'dired-uncompress)
  137.   (define-key dired-mode-map "B" 'dired-byte-recompile)
  138.   (define-key dired-mode-map "M" 'dired-chmod)
  139.   (define-key dired-mode-map "G" 'dired-chgrp)
  140.   (define-key dired-mode-map "O" 'dired-chown))
  141.  
  142.  
  143. ;; Dired mode is suitable only for specially formatted data.
  144. (put 'dired-mode 'mode-class 'special)
  145.  
  146. (defun dired-mode (&optional dirname)
  147.   "Mode for \"editing\" directory listings.
  148. In dired, you are \"editing\" a list of the files in a directory.
  149. You can move using the usual cursor motion commands.
  150. Letters no longer insert themselves.
  151. Instead, type d to flag a file for Deletion.
  152. Type u to Unflag a file (remove its D flag).
  153.   Type Rubout to back up one line and unflag.
  154. Type x to eXecute the deletions requested.
  155. Type f to Find the current line's file
  156.   (or Dired it, if it is a directory).
  157. Type o to find file or dired directory in Other window.
  158. Type # to flag temporary files (names beginning with #) for Deletion.
  159. Type ~ to flag backup files (names ending with ~) for Deletion.
  160. Type . to flag numerical backups for Deletion.
  161.   (Spares dired-kept-versions or its numeric argument.)
  162. Type r to rename a file.
  163. Type c to copy a file.
  164. Type v to view a file in View mode, returning to Dired when done.
  165. Type g to read the directory again.  This discards all deletion-flags.
  166. Space and Rubout can be used to move down and up by lines.
  167. Also: C -- compress this file.  U -- uncompress this file.
  168.       B -- byte compile this file.
  169.  M, G, O -- change file's mode, group or owner.
  170. \\{dired-mode-map}"
  171.   (interactive)
  172.   (kill-all-local-variables)    
  173.   (make-local-variable 'revert-buffer-function)
  174.   (setq revert-buffer-function 'dired-revert)
  175.   (setq major-mode 'dired-mode)
  176.   (setq mode-name "Dired")
  177.   (make-local-variable 'dired-directory)
  178.   (setq dired-directory (or dirname default-directory))
  179.   (if dirname
  180.       (setq default-directory 
  181.         (if (file-directory-p dirname)
  182.         dirname (file-name-directory dirname))))
  183.   (setq mode-line-buffer-identification '("Dired: %17b"))
  184.   (setq case-fold-search nil)
  185.   (setq buffer-read-only t)
  186.   (use-local-map dired-mode-map)
  187.   (run-hooks 'dired-mode-hook))
  188.  
  189. (defun dired-repeat-over-lines (arg function)
  190.   (beginning-of-line)
  191.   (while (and (> arg 0) (not (eobp)))
  192.     (setq arg (1- arg))
  193.     (save-excursion
  194.       (beginning-of-line)
  195.       (and (bobp) (looking-at "  total")
  196.        (error "No file on this line"))
  197.       (funcall function))
  198.     (forward-line 1)
  199.     (dired-move-to-filename))
  200.   (while (and (< arg 0) (not (bobp)))
  201.     (setq arg (1+ arg))
  202.     (forward-line -1)
  203.     (dired-move-to-filename)
  204.     (save-excursion
  205.       (beginning-of-line)
  206.       (funcall function))))
  207.  
  208. (defun dired-flag-file-deleted (arg)
  209.   "In dired, flag the current line's file for deletion.
  210. With arg, repeat over several lines."
  211.   (interactive "p")
  212.   (dired-repeat-over-lines arg
  213.     '(lambda ()
  214.        (let ((buffer-read